{*******************************************************************************
* The contents of this file are used with permission, subject to the Mozilla   *
* Public License Version 1.1 (the "License"); you may not use this file except *
* in compliance with the License. You may obtain a copy of the License at      *
* http://www.mozilla.org/MPL/                                                  *
*                                                                              *
* Software distributed under the License is distributed on an "AS IS" basis,   *
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for *
* the specific language governing rights and limitations under the License.    *
*                                                                              *
* The Original Code is distributed as part of the "mediate" product and is     *
* Copyright (C) @home media limited. All Rights Reserved.                      *
*                                                                              *
* Email: support@athomemedia.co.uk                                             *
* Web:   http://www.athomemedia.co.uk                                          *
*******************************************************************************}

unit CompressionHelper;

interface

uses Classes, JvZLibMultiple;

type
  TAHMZLibMultiple = class(TJvZLibMultiple)
  public
    procedure ScanFolder(Root, Folder: String; Stream: TStream; Recursive: Boolean);
  end;

  TAHMCompressionHelper = class
  private
    FZip: TAHMZLibMultiple;
    FFileList: TStrings;
    FFilter: String;
    FArchivePath: String;
    FExtractPath: String;
    procedure SetArchivePath(ArchivePath: String);
    procedure SetExtractPath(ExtractPath: String);
    procedure DecompressingFile(Sender: TObject; const FileName: string; var WriteFile: Boolean);
  protected
    property Zip: TAHMZLibMultiple read FZip;
    property FileList: TStrings read FFileList;
    property ExtractFilter: String read FFilter write FFilter;
    property ArchivePath: String read FArchivePath write SetArchivePath;
    property ExtractPath: String read FExtractPath write SetExtractPath;
  public
    constructor Create;
    destructor Destroy; override;
    class function CompressAll(const ArchiveURL, SourceDir: String; Recursive: Boolean): Boolean;
    class function CompressFile(const ArchiveURL, SourceFile: String): Boolean;
    class function CompressFiles(const ArchiveURL: String; SourceFiles: TStrings): Boolean;
    class function ExtractAll(const ArchiveURL, TargetDir: String; Overwrite: Boolean): Boolean;
    class function ExtractFile(const ArchiveURL, TargetDir, FileName: String; Overwrite: Boolean): Boolean;
    class function ListFiles(const ArchiveURL: String; FileNames: TStrings): Boolean;
  end;

implementation

uses Windows, SysUtils;

// TAHMZLibMultiple

procedure TAHMZLibMultiple.ScanFolder(Root, Folder: String; Stream: TStream; Recursive: Boolean);
var
  SR: TSearchRec;
  DirList: TStringList;
  Found, i: Integer;
begin
  // Ensure directories have a trailing slash
  if (Root <> '') and (Root[Length(Root)] <> '\') then Root := Root + '\';
  if (Folder <> '') and (Folder[Length(Folder)] <> '\') then Folder := Folder + '\';

  // Defer allocating directory list until required
  DirList := nil;

  // Scan all files in this directory
  Found := FindFirst(Root + Folder + '*.*', faAnyFile, SR);
  while Found = 0 do
  begin
    // Ignore current, parent and subversion directories
    if Copy(SR.Name, 1, 1) <> '.' then
    begin
      if (SR.Attr and faDirectory) <> 0 then
      begin
        // Make a note of this folder for checking later
        if (DirList = nil) and Recursive then DirList := TStringList.Create;
        if (DirList <> nil) then DirList.Add(Folder + SR.Name);
      end
      else
      begin
        // Compress this file and append to stream
        AddFile(SR.Name, Folder, Root + Folder + SR.Name, Stream);
      end;
    end;

    // Keep looking
    Found := FindNext(SR);
  end;
  FindClose(SR);

  // Scan the list of subdirectories recursively
  if Assigned(DirList) then
    for i := 0 to Pred(DirList.Count) do
      ScanFolder(Root, DirList[i], Stream, Recursive);
end;


// TAHMCompressionHelper

constructor TAHMCompressionHelper.Create;
begin
  inherited;

  FZip := TAHMZLibMultiple.Create(nil);
  FZip.OnDecompressingFile := DecompressingFile;
  FFileList := TStringList.Create;
end;

destructor TAHMCompressionHelper.Destroy;
begin
  FZip.Free;
  FFileList.Free;

  inherited;
end;

procedure TAHMCompressionHelper.SetArchivePath(ArchivePath: String);
begin
  if FArchivePath <> ArchivePath then
  begin
    FArchivePath := ArchivePath;

    // Throw an exception if for some reason we can't create target dir
    if not ForceDirectories(ArchivePath) then Abort;
  end;
end;

procedure TAHMCompressionHelper.SetExtractPath(ExtractPath: String);
begin
  if FExtractPath <> ExtractPath then
  begin
    FExtractPath := ExtractPath;

    // Throw an exception if for some reason we can't create target dir
    if not ForceDirectories(ExtractPath) then Abort;
  end;
end;

procedure TAHMCompressionHelper.DecompressingFile(Sender: TObject; const FileName: string; var WriteFile: Boolean);
begin
  // Apply filtering on extraction if required
  if FFilter = '' then
    WriteFile := True
  else
    WriteFile := AnsiSameText(ExtractFileName(FileName), FFilter);
end;

class function TAHMCompressionHelper.CompressAll(const ArchiveURL, SourceDir: String; Recursive: Boolean): Boolean;
var
  Stream: TMemoryStream;
begin
  // Set default result - operation failed
  Result := False;

  with TAHMCompressionHelper.Create do
  try
    try
      ArchivePath := ExtractFilePath(ArchiveURL);

      // Create a memory stream to generate archive
      Stream := TMemoryStream.Create;
      try
        Zip.ScanFolder(SourceDir, '', Stream, Recursive);
        Stream.Position := 0;
        Stream.SaveToFile(ArchiveURL);
        Result := True;
      finally
        Stream.Free;
      end;
    except
      // Ignore exceptions - just return failure result
    end;
  finally
    Free;
  end;
end;

class function TAHMCompressionHelper.CompressFile(const ArchiveURL, SourceFile: String): Boolean;
begin
  // Set default result - operation failed
  Result := False;

  with TAHMCompressionHelper.Create do
  try
    try
      ArchivePath := ExtractFilePath(ArchiveURL);
      FileList.Add(SourceFile);
      Zip.CompressFiles(FileList, ArchiveURL);
      Result := True;
    except
      // Ignore exceptions - just return failure result
    end;
  finally
    Free;
  end;
end;

class function TAHMCompressionHelper.CompressFiles(const ArchiveURL: String; SourceFiles: TStrings): Boolean;
begin
  // Set default result - operation failed
  Result := False;

  if not Assigned(SourceFiles) then Exit;

  with TAHMCompressionHelper.Create do
  try
    try
      ArchivePath := ExtractFilePath(ArchiveURL);
      Zip.CompressFiles(SourceFiles, ArchiveURL);
      Result := True;
    except
      // Ignore exceptions - just return failure result
    end;
  finally
    Free;
  end;
end;

class function TAHMCompressionHelper.ExtractAll(const ArchiveURL, TargetDir: String; Overwrite: Boolean): Boolean;
begin
  // Set default result - operation failed
  Result := False;

  with TAHMCompressionHelper.Create do
  try
    try
      ExtractPath := TargetDir;
      Zip.DecompressFile(ArchiveURL, TargetDir, Overwrite, True);
      Result := True;
    except
      // Ignore exceptions - just return failure result
    end;
  finally
    Free;
  end;
end;

class function TAHMCompressionHelper.ExtractFile(const ArchiveURL, TargetDir, FileName: String; Overwrite: Boolean): Boolean;
begin
  // Set default result - operation failed
  Result := False;

  with TAHMCompressionHelper.Create do
  try
    try
      ExtractPath := TargetDir;
      ExtractFilter := FileName;
      Zip.DecompressFile(ArchiveURL, TargetDir, Overwrite, True);
      Result := True;
    except
      // Ignore exceptions - just return failure result
    end;
  finally
    Free;
  end;
end;

class function TAHMCompressionHelper.ListFiles(const ArchiveURL: String; FileNames: TStrings): Boolean;
begin
  // Set default result - operation failed
  Result := False;

  if not Assigned(FileNames) then Exit;

  with TAHMCompressionHelper.Create do
  try
    try
      Zip.ListStoredFiles(ArchiveURL, FileNames);
      Result := True;
    except
      // Ignore exceptions - just return failure result
    end;
  finally
    Free;
  end;
end;


end.
